home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997 September / Macworld (1997-09).dmg / Serious Software / Cherwell Scientific Demos / pro Fit / pro Fit 5.0 demo (fpu).sea / pro Fit 5.0 demo (fpu) / Functions & Programs / Polar plot < prev    next >
Text File  |  1996-04-20  |  5KB  |  197 lines
  1. { This file defines the program PolarPlot:
  2.  
  3.  - creates a graph if necessary
  4.  - a polar grid in it if desired
  5.  - plots a data set in the polar plot
  6.  
  7.  To use this program:
  8.  1. Choose "Add to Menu" from the "Misc" menu to add them
  9.     to your menus.
  10.  2. Open a data window and enter your data points (phi[deg], r)
  11.  3. Choose "PolarPlot" from the "Misc" menu to plot them.
  12. }
  13.  
  14.  
  15. program PolarPlot;
  16. var
  17.   phi, r, rmax, radmax, ncirc, degrad, windID, dataID, curGraph;
  18.   x, y;         { results of Translate }
  19.   left, top, right, bottom, mean;
  20.   phiColumn, rColumn, i;
  21.   plotCG, plotGrid, drawLabels;
  22.  
  23.  
  24. procedure Initialize;
  25.  { set defaults }
  26. begin
  27.   plotCG := 0;
  28.   plotGrid := 1;
  29.   drawLabels := 1;
  30.   phiColumn := 1;
  31.   rColumn := 2;
  32.   radmax := 1;
  33.   ncirc := 5;
  34.   degrad := 5;
  35. end;
  36.  
  37.  
  38. procedure Translate(r, p);
  39.  { translates the point at r,pp (=radius, phi in degree) to a coordinate }
  40.  { in the current graph. The result is stored in the variables x, y }
  41.   var phiRad;
  42. begin
  43.   phiRad := p * (π/180);
  44.   x := cos(phiRad) * r;
  45.   y := sin(phiRad) * r;
  46. end;
  47.  
  48.  
  49. procedure PreparePolarPlot;
  50. var cenH, cenV;
  51. begin
  52.   windID := FrontmostWindow(drawingType);
  53.   if windID = 0 then
  54.     NewWindow(drawingType)
  55.   else
  56.     BringWindowToFront(windID);    { it could contain the current graph }
  57.   rmax := radmax * 1.1;
  58.   SetLineColor(0,0,0);
  59.   
  60.   curGraph := GetCurrentGraph;
  61.   if (not plotCG) or (curGraph = 0) then
  62.   begin
  63.     DisableDrawingUpdates;    { when creating the graph and the grid we want less update }
  64.     GroupBegin;
  65.     
  66.       { create the graph }
  67.     CreateNewGraph(-rmax,rmax,-rmax,rmax,0,0);
  68.     
  69.    { draw and set the axes, ticks and labels (radial) }
  70.     SetCurrentAxis(xAxis,1);
  71.     SetAxisPosition(xAxis,-rmax);
  72.     MakeTicks(xAxis,0,radmax,ncirc-1);
  73.     if drawLabels then
  74.     begin
  75.       MakeTicks(xAxis,0,radmax,ncirc-1);
  76.       SetAxisAttributes(xAxis,drawAxisLine+drawTicks+drawMajorTickLabels+plusSideTicks)
  77.     end
  78.     else
  79.       SetAxisAttributes(xAxis,drawAxisLine);
  80.     SetCurrentAxis(xAxis,2);
  81.     SetAxisPosition(xAxis,rmax);
  82.     SetAxisAttributes(xAxis,drawAxisLine);
  83.     SetCurrentAxis(yAxis,1);
  84.     SetAxisPosition(yAxis,-rmax);
  85.     SetAxisAttributes(yAxis,drawAxisLine);
  86.     SetCurrentAxis(yAxis,2);
  87.     SetAxisPosition(yAxis,rmax);
  88.     SetAxisAttributes(yAxis,drawAxisLine);
  89.     
  90.    { set the graphs size }
  91.     GetGraphFrame(left,top,right,bottom);
  92.     mean := (left + top + right + bottom) / 4;
  93.     if mean < 150 then
  94.       mean := 150;
  95.     SetGraphFrame(left,top,left + mean,top + mean); { make it a square }
  96.     
  97.    { draw the angles labels and an arc with arrow }
  98.     if drawLabels then
  99.     begin
  100.       cenH := left + mean * 0.5;
  101.       cenV := top + mean * 0.5;
  102.       
  103.       SetArrowStyle(2,1,16);
  104.       OpenPoly(1,false);
  105.       phi := π/18;
  106.       MoveTo(cenH + mean * 0.6 * cos(phi), cenV - mean * 0.6 * sin(phi));
  107.       phi := phi + π/18;
  108.       repeat
  109.         LineTo(cenH + mean * 0.6 * cos(phi), cenV - mean * 0.6 * sin(phi));
  110.         phi := phi + π/18;
  111.       until phi > π/2 - π/18;
  112.       ClosePoly;
  113.       SetArrowStyle(2,0,16);
  114.       
  115.       MoveTo(cenH + mean * 0.6, cenV);
  116.       DrawText('0°',0,true);
  117.       MoveTo(cenH, cenV - mean * 0.6);
  118.       DrawText('90°',0,true);
  119.     end;
  120.     GroupEnd;
  121.   end;
  122.   
  123.   if plotGrid then
  124.   begin
  125.     SetLineStyle(1,1);
  126.     SetLineColor(65000, 0, 65000); { magenta }
  127.     OpenCurve('grid radial');
  128.     if degrad <= 4 then
  129.          r := 15 * degrad
  130.        else if degrad <= 6 then
  131.          r := 30 * (degrad - 2)
  132.     else
  133.       r := 180 * (degrad - 6);
  134.     r := r * π / 180;
  135.     phi := 0;
  136.     repeat
  137.       MoveTo(0, 0); LineTo(cos(phi) * rmax, sin(phi) * rmax);
  138.       phi := phi + r;
  139.     until phi >= 2 * π;
  140.     CloseCurve;
  141.     SetLineStyle(0.5,1);
  142.     SetLineColor(0, 0, 65000); { blue }
  143.     OpenCurve('grid circular');
  144.     r := radmax / ncirc;
  145.     repeat
  146.       MoveTo(r, 0);
  147.       phi := 6;
  148.       repeat
  149.         Translate(r, phi);
  150.         LineTo(x, y);
  151.         phi := phi + 6;
  152.       until phi > 360;
  153.       r := r + radmax / ncirc;
  154.     until r * 0.99 > radmax;
  155.     CloseCurve;
  156.   end;
  157.   
  158. end;
  159.  
  160.  
  161. begin
  162.   curGraph := GetCurrentGraph;
  163.   if curGraph = 0 then
  164.   begin
  165.     plotCG := 0;
  166.     plotGrid := 1;
  167.     drawLabels := 1;
  168.   end
  169.   else
  170.   begin
  171.     plotCG := 1;
  172.     plotGrid := 0;
  173.     drawLabels := 0;
  174.   end;
  175.   SetBoxTitle('Polar Plot Preparation');
  176.   Input('$XPlot into current graph', plotCG,
  177.         '$XPlot polar grid', plotGrid,
  178.         '$XDraw labels', drawLabels,
  179.         'Maximum radius', radmax,
  180.         '$P1;2;3;4;5;6;7;8;9;10$# circular gridlines', ncirc,
  181.         '$P15;30;45;60;90;120;180;360$Radial gridlines at', degrad);
  182.  PreparePolarPlot;
  183.  SetBoxTitle('Polar Plot');
  184.  Input('$WData window', dataID, '$CAngle [degree]', phiColumn, '$CRadius', rColumn);
  185.  SetDataPointStyle(15,6,1);
  186.  SetLineColor(65535, 0, 0); { red }
  187.  OpenDataSet(false,false,'data');
  188.  for i:=1 to nrRows do
  189.   if (dataOK(i, phiColumn) and dataOK(i,rColumn)) then  { if both fields hold a value }
  190.   begin
  191.     Translate(data[i, rColumn], data[i, phiColumn]);
  192.     AddDataPoint(x,y,0,0,0,0);
  193.   end;
  194. end;
  195.  
  196.   
  197.